perm filename FILLER.ZLD[MSS,LCS] blob
sn#096347 filedate 1974-04-05 generic text, type T, neo UTF8
00010 SUBROUTINE FILLER
00110 COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00123 COMMON /RZ/RSZ,IPLT,RJB,CENTR
00136 COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00150 REAL LF
00200 COMMON Q(200),R(200),E(200),NN
00210 COMMON/LL/L
00300 DIMENSION P(50)
00600
01310 RR=RSZ
01320 IF(IXRX)RSZ=RSZ*1.7
01330 C FOR XGP
01400 KK=0
01410 A=1000
01420 B=-1000
01430 D=-1000
01440 C=1000
01490 206 DO 205 J=IC,MCLEF(1)
01500 CALL UNPACK(J,M,N,MCLEF)
01505 KK=KK+1
01510 E(KK)=0
01520 IF(L.GE.100000000)E(KK)=-1
01530 208 Q(KK)=(M+RJB)*RSZ
01535 IF(Q(KK).LT.A)A=Q(KK)
01537 IF(Q(KK).GT.B)B=Q(KK)
01540 R(KK)=(N+CENTR)*RSZ
01550 IF(R(KK).LT.C)C=R(KK)
01560 205 IF(R(KK).GT.D)D=R(KK)
01590 RSZ=1
01600 GO TO 201
01690 400 DO 40 K=1,KK
01695 J=2
01700 IF(E(K))J=3
01800 40 CALL LINES(Q(K),R(K),J)
01900 201 N=1
02000 4 J=0
02010 CALL DPYOUT(1)
02100 CC H=-1000
02110 M=4
02120 IF(IXRX)M=2
02200 Z=-1000
02250
02300 DO 1 K=IFIX(A),IFIX(B),M
02400 G=K
02600 Y=1000
02700 KJ=0
02750 44 Z=-1000
02760
02800 DO 45 J=2,KK
02810 IF(E(J))GO TO 45
02900 QB=Q(J)
03000 QA=Q(J-1)
03100 IF(QA.EQ.QB)GO TO 45
03200 IF((G.EQ.QA.OR.G.EQ.QB).AND.Y.NE.-1000)GO TO 1
03400 46 IF(((G.GT.QB.OR.G.LT.QA).AND.QB.GT.QA).OR.((G.LT.QB.OR.G.GT.QA)
03450 1.AND.QA.GT.QB))GO TO 45
03500 C MISSES LINES
03600 X=HGHT(R(J),R(J-1),G,Q(J-1),Q(J))
03700 IF(X.LE.Z.OR.X.GE.Y)GO TO 45
03800 Z=X
03900 45 CONTINUE
04000 IF(Z.EQ.-1000)GO TO 47
04100 49 KJ=KJ+1
04200 P(KJ)=Z
04300 Y=Z
04400 C RESETS TOP AND BOTTOM
04500 GO TO 44
04600 47 IF(KJ.LE.1)GO TO 1
04700 IF(MOD(KJ,2).NE.0)KJ=KJ-1
04800 DO 48 L=1,KJ,2
04900 CALL LINES(FLOAT(K),P(L),3)
05100 48 CALL LINES(FLOAT(K),P(L+1),2)
05200 CALL DPYOUT(1)
05300 1 CONTINUE
06000 RSZ=RR
12000 END
13000
13100 FUNCTION HGHT(A,B,C,D,E)
13200 HGHT=((A-B)*(C-D))/(E-D)+B
13250 IF(E.EQ.D)HGHT=B
13300 END